home *** CD-ROM | disk | FTP | other *** search
/ The Game Master (3rd Edition) / The Game Master 3rd edition.iso / files / demo_vga / democga / globe.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-01-24  |  3.5 KB  |  129 lines
  1. 10  'Real Time Perspective Image of Rotated Globe
  2. 20  '
  3. 30  'Original program by: Karl Koessel
  4. 40  '
  5. 50  'Animation by: Andrew Tuline
  6. 60  '
  7. 70  'This program has been modified from the original submitted to
  8. 80  'PCWORLD magazine. The initialization draws 5 different images
  9. 90  'and stores the array for each image to disk. This process requires
  10. 100  'about 15 minutes. The data file GLOBE.DAT is stored to disk.
  11. 110  'The program checks for this data file, and if not available, will
  12. 120  'create one. Once this file has been created, the program will load
  13. 130  'it into the corresponding arrays, and will display a realtime rotating
  14. 140  'globe in the Screen 2 mode. The globe occupies a small section of the
  15. 150  'screen and shows best results when used with an RGB monitor. This seems
  16. 160  'a good example of non-flickering graphics in Basic.
  17. 170  '
  18. 180  '
  19. 190  RANDOMIZE VAL(LEFT$(TIME$,2))
  20. 200  SCREEN 2:CLS:KEY OFF:DEFINT L,R,X-Z
  21. 210  OUT &H3D9,3
  22. 220  DIM RC(11),A%(380),B%(380),C%(380),D%(380),E%(380)
  23. 230  ON ERROR GOTO 1230
  24. 240  OPEN "GLOBE.DAT" FOR INPUT AS #1
  25. 250  FOR I=0 TO 380:INPUT #1,A%(I):NEXT
  26. 260  FOR I=0 TO 380:INPUT #1,B%(I):NEXT
  27. 270  FOR I=0 TO 380:INPUT #1,C%(I):NEXT
  28. 280  FOR I=0 TO 380:INPUT #1,D%(I):NEXT
  29. 290  FOR I=0 TO 380:INPUT #1,E%(I):NEXT
  30. 300  CLS:X=320:Y=100
  31. 310  ON INT(RND*4)+1 GOTO 320,330,340,350,310
  32. 320  X=X+1:IF X>530 THEN X=530:GOTO 360 ELSE 360
  33. 330  X=X-1:IF X<0 THEN X=0:GOTO 360 ELSE 360
  34. 340  Y=Y-1:IF Y<0 THEN Y=0:GOTO 360 ELSE 360
  35. 350  Y=Y+1:IF Y>146 THEN Y=146:GOTO 360 ELSE 360
  36. 360  PUT (X,Y),A%,PSET
  37. 370  PSET (RND*639,RND*199),0
  38. 380  PUT (X,Y),B%,PSET
  39. 390  PSET (RND*639,RND*199),1
  40. 400  PUT (X,Y),C%,PSET
  41. 410  PSET (RND*639,RND*199),0
  42. 420  PUT (X,Y),D%,PSET
  43. 430  PSET (RND*639,RND*199),1
  44. 440  PUT (X,Y),E%,PSET
  45. 450  PSET (RND*639,RND*199),0
  46. 460  A$=INKEY$:IF A$="" THEN 310 ELSE END
  47. 470  OPEN "GLOBE.DAT" FOR OUTPUT AS #1
  48. 480  CX=CY:CZ=SX:SY=SZ:I=J:R=A:B=C:A1=B2:C1=C2
  49. 490  A3=B3:X=Y:XC=YC:LX=LY:B$=C$:RC=PI:LZ=ZS:Q=DR
  50. 500  FOR X=1 TO 11
  51. 510       RC(X)=(X-1)MOD 3+1
  52. 520      IF X>6 THEN RC(X)=(5-RC(X))MOD 3+1
  53. 530  NEXT
  54. 540  PI=3.14159
  55. 550  CF=PI/180
  56. 560  GOSUB 1160
  57. 570  FOR YROT=120 TO 132 STEP 3
  58. 580  GOSUB 660
  59. 590  GET (265,73)-(373,126),A%
  60. 600  FOR I=0 TO 380:PRINT #1,A%(I):NEXT
  61. 610  NEXT
  62. 620  BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP:SOUND 32000,1:BEEP
  63. 630  CLOSE #1
  64. 640  A$=INKEY$:IF A$<>"" THEN 640
  65. 650  GOTO 240
  66. 660  CX=COS(CF*XROT+ATN(YOBS/ZOBS)):SX=SIN(CF*XROT+ATN(YOBS/ZOBS))
  67. 670  CY=COS(CF*YROT+ATN(XOBS/ZOBS)):SY=SIN(CF*YROT+ATN(XOBS/ZOBS))
  68. 680  CZ=COS(CF*ZROT):SZ=SIN(CF*ZROT)
  69. 690  ZOBS=SQR(XOBS^2+YOBS^2+ZOBS^2)
  70. 700  ZS=R^2/ZOBS
  71. 710  CLS
  72. 720  LOCATE 1,1:PRINT"Initializing GLOBE.DAT. 5 beeps will sound upon completion"
  73. 730  LOCATE 5,5:PRINT USING "Picture # of 5";(YROT-117)/3
  74. 740  FOR I=0 TO 3 STEP PI/12
  75. 750      RC=(I*12/PI+2)MOD 3+1
  76. 760      C$=STR$(RC)
  77. 770      C$="3"
  78. 780      FOR J=0 TO 2.0001*PI STEP PI/24
  79. 790              A=R*SIN(I)*SIN(J)
  80. 800              B=R*COS(J)
  81. 810              C=R*COS(I)*SIN(J)
  82. 820              GOSUB 990
  83. 830              GOSUB 1090
  84. 840      NEXT
  85. 850  NEXT
  86. 860  FOR I=PI/12 TO 11*PI/12 STEP PI/12
  87. 870      RC=RC(I*12/PI)
  88. 880      C$=STR$(RC)
  89. 890      C$="3"
  90. 900      FOR J=0 TO 2.0001*PI STEP PI/24
  91. 910              A=R*SIN(I)*SIN(J)
  92. 920              B=R*COS(I)
  93. 930              C=R*SIN(I)*COS(J)
  94. 940              GOSUB   990
  95. 950              GOSUB 1090
  96. 960      NEXT
  97. 970  NEXT
  98. 980  RETURN
  99. 990  A1=A*CY-C*SY
  100. 1000  C1=A*SY+C*CY
  101. 1010  B2=B*CX-C1*SX
  102. 1020  C2=B*SX+C1*CX
  103. 1030  A3=A1*CZ-B2*SZ
  104. 1040  B3=A1*SZ+B2*CZ
  105. 1050  DR=C2/(ZOBS-C2)+1
  106. 1060  X=INT(A3*DR*ASP+XC)
  107. 1070  Y=INT(B3*-DR+YC)
  108. 1080  RETURN
  109. 1090  IF C2<ZS OR LZ<ZS THEN B$="BC":GOTO 1120
  110. 1100  Q=(X<0)+(X>639)+(Y<0)+(Y>199)+(LX<0)+(LX>639)+(LY<0)+(LY>199)
  111. 1110  IF Q+(J=0) THEN B$="BC" ELSE B$="C"
  112. 1120  LX=X:LY=Y
  113. 1130  LZ=C2
  114. 1140  DRAW B$+C$+"M"+STR$(X)+","+STR$(Y)
  115. 1150  RETURN
  116. 1160  XC=320:YC=100
  117. 1170  XOBS=-9:YOBS=0:ZOBS=456
  118. 1180  XROT=37:ZROT=23:'YROT=-123
  119. 1190  R=25
  120. 1200  BCK=1:PAL=1
  121. 1210  ASP=2
  122. 1220  RETURN
  123. 1230  IF ERR<>53 THEN PRINT"error":END
  124. 1240  ON ERROR GOTO 1260
  125. 1250  OPEN"i",1,"b:globe.dat:":GOTO 250
  126. 1260  IF ERR=53 THEN RESUME 1250 ELSE 1230
  127. 1270  RESUME 470
  128. 1280  END' of Program
  129.